00100	;Floppy disk file system.
00200	.INSERT ASMBL.FAI[CMS,LCS]
00300	   ZERO ← 0
00400	   LOC ZERO ;Fail offset
00500	
00600	CBLK:	0	;Ram command block.
00700	CCNT:	0	;C parameter count.
00800	CLEN:	0	;C # of sectors.
00900	CSEC:	0	;C sector
01000	CTRK:	0	;C track
01100		0
01200	FOTRK:	0	;Format track number.
01300		0
01400	FCMD:	0	;Disk command pointer.
01500	FCMDH:	0
01600	CMDJMP:	0	;Indirect command jump.
01700	CJMPH:	0	;Msbyte.
01800	ERFLG:	0	;Error flag/code.
01900	SVERR:	0	;Saved error.
02000	CEFLG:	0	;Communication error flag.
02100	RFOPEN:	0	;Read file open flag.
02200	WFOPEN:	0	;Write file open flag
02300	DIRC:	0	;Data direction
02400	FLEN:	0	;File length. In sectors.
02500	FITRK:	0	;Compress file track.
02600	FISEC:	0	;Compress file sector.
02700	SREM:	0	;Sectors remaining.
02800	NTRYS:	0	;Number of retrys before error.
02900	BUSY:	0	;Busy flag
03000	MO:	0	;Motor on flag. MFLG = TL or TH?
03100	TL:	0	;Motor time out low.
03200	TH:	0	;Time out high.
03300	DIRCNT:	0	;Directory sector count
03400	HTRK:	0	;Hole track number
03500	HSEC:	0	;Hole sector number
03600	SVHY:	0	;Hole directory index.
03700	SVHSEC:	0	;Hole directory sector.
03800	FBLK:	0	;File block
03900	FNAME:	BLOCK 11	;9 Chr file name.
04000	NSEC:	0	;Number of sectors in file.
04100	FTRK:	0	;Disk track number
04200	FSEC:	0	;Disk sector number
04300		BLOCK 3
04400	DBLK:	0	;Directory block
04500	DSEC:	0	;Number of sectors in directory.
04600	FFDIR:	0	;First free directory block
04700	FFTRK:	0	;First free data track
04800	FFSEC:	0	;First free data sector
04900	FBLKS:	0	;Number of free sectors. In sectors.
05000	FBH:	0	;Msbyte
05100		0
05200	CKSUM:	0	;Check sum.
05300	SPOINT:	0	;SI/O pointer.
05400	SPOH:	0	;Msbyte
05500	DPOINT:	0	;Disk buffer bointer.
05600	DPOH:	0	;Msbyte
05700	
05800	   LOC ZERO+1000
05900	FBUF:	0	;Disk data buffer.
06000	   LOC FBUF+400
06100	FBUF1:	0	;Other buffer.
     

00100		LOC ZERO+174000	;PROM Start address.
00150	FCTBL:
00200	   DINIT ← 0
00300		65	;Specify
00400		4	;Parameter count.
00500		252	;H unload I cnt./ H load time.
00600		=25	;Head settling time in ms*2.
00700		=20	;Step rate in ms*2.
00800		15	;Init
00900	   SBT ← 6
01000		65	;Specify
01100		4
01200		0	;Current track.
01300		377
01400		377	;No bad tracks.
01500		20	;Surface zero bad tracks command.
01600	   DMA ← 14
01700		172	;Write special register.
01800		2
01900		0	;DMA and double actuator.
02000		27	;Mode register.
02100	   RESTOR ← 20
02200		151	;Seek track zero command.
02300		1	;With head load.
02400		0	;Track zero
02500	   MON ← 23
02600		172	;Write special register.
02700		2	;Clear out pins.
02800		40	;Optional output / motor on bit.
02900		43	;Drive control output register.
03000	   MOFF ← 27
03100		172	;Write special register.
03200		2	;Clear out pins.
03300		0	;Optional output / motor off.
03400		43	;Drive control output register.
03500	   RHDR0 ← 33
03600	RH0:	123	;Read two sectors command.
03700		3
03800		2	;# of sectors.
03900		1	;Header sector number
04000		0	;Header track number
04100	   WHDR0 ← 40
04200	WH0:	113	;Write two sectors command.
04300		3
04400		2	;# of sectors.
04500		1	;Header sector number.
04600		0	;Header track number.
04700	    RDSTAT ← 45
04800		154	;Read drive status command.
04900		0
     

00100	ID0:	113	;Write two sectors.
00200		3
00300		=16	;# of sectors.
00400		1	;First sector.
00500		0	;Track zero.
00600	FORMT:	143	;Format track command.
00700		5
00800		=16	;Gap 1 -6.
00900		0	;Gap 5. No index mark.
01000		=16	;Sectors per track.
01100		=27	;Gap 3 -6.
01200		0	;Format track number.
01300	
01400	   RETRY ← =10	;Number of retrys until error.
01500	   DMARK ← 74	;Directory mark
01600	   FMARK ← 72	;File mark
01700	   HMARK ← 67	;Hole mark?
01800	   LASTRK ← =34	;Last track
     

00100	;Octal to ascii in FBLKS and NXTDIR.
00200	;Put GEOT in DECODE.
00300	;Add restore to retry?
00400	;COMERRs ?  In ACK?
00500	;Add write protect and not ready error codes.
00600	;Flush other dir. = LASTRK?
00700	
00800	;Power on reset.
00900	RST:	LDXI	377	;Setup stack.
01000		TXS
01100		CLD	;Clear decimal mode.
01200	
01300	;Reset I/O
01400	   SIOC  ← 20000	;SI/O command register.
01500	   SIOD  ← 20001	;SI/O data register.
01600	   FDSKC ← 10000	;Disk command/status register
01700	   FDSKP ← 10001	;Disk parameter/result register
01800	   FDSKR ← 10002	;Disk reset register.
01900	   FDRQ  ← 14000	;Disk DMA data request
02000	
02100	;Init floppy disk controller.
02200		LDAI	1	;Reset disk again.
02300		STA	FDSKR
02400		NOP
02500		NOP
02600		NOP
02700		LSRA	;Clear A
02800		STA	FDSKR
02900	
03000		LDAI	DINIT	;Disk initialization command.
03100		JSR	PCMD	;Prom command.
03200		LDAI	DMA	;Setup DMA mode.
03300		JSR	PCMD
03400		LDXI	377
03500		STXZ	TL
03600		LDAI	10
03700		STAZ	TH
03800	RLOOP:	DEX	;Power on delay.
03900		BNE	RLOOP
04000		DECZ	TL
04100		BNE	RLOOP
04200		DECZ	TH
04300		BNE	RLOOP
04400	
04500		LDAI	RESTOR	;Restore track zero.
04600		JSR	PCMD
04700	
04800		LDAI	SBT	;Setup bad tracks
04900		JSR	PCMD
05000		LDA	FDSKP	;Read result reg. to clr int.?
05100	;Reset SI/O
05200		LDAI	3	;Reset bits
05300		STA	SIOC
05400		LDAI	25	;ACIA control word.
05500		STA	SIOC
05600	
05700	;Init RAM
05800		LDAZ	DSEC
05900		STAZ	DIRCNT	;Point to end of directory.
06000		LDAI	0
06100		STAZ	MO	;Init motor flag.
     

00100	IDLSET:	LDAI	0
00200		STAZ	RFOPEN	;Reset read file open flag.
00300		STAZ	WFOPEN	;Clear write file open flag.
00400	
00500		STAZ	CEFLG	;Clear comm. error flag.
00600		STAZ	ERFLG	;Clear error flag.
00700		STAZ	SVERR	;Clear other error flag.
00800	
00900		STAZ	DIRC	;Set disk to read.
01000		STAZ	BUSY	;Set to not busy.
01100		TAX	;Start lsbyte of motor time out.
01200		CLI	;Enable interrupts?
01300	
01400	   TWOS ← 3	;3 = 1.77s, 4 = 2.3s.
01500	;	JSR	IDLEW	?
01600	IDLE:	BITZ	MO	;Check if motor on.
01700		BPL	GSOH
01800		LDA	SIOC	;Read SI/O status.
01900		LSRA	;Get rcvr. full bit.
02000		BCS	GSOH
02100	
02200		DEX	;Time out countdown.
02300		BNE	IDLE
02400		DECZ	TL
02500		BNE	IDLE
02600		DECZ	TH
02700		BNE	IDLE
02800		JSR	MOTOFF	;Turn off motor.
02900	
03000	GSOH:	JSR	GCHR	;Wait for SOH.
03100		CMPI	1	;<SOH>.
03200		BNE	ILLCMD	;Error.
03300		JSR	GCHR	;Wait for command.
     

00100	DCODE:	LDXI	NCMDS	;# of commands.
00200	DL:	CMPX	CMDTBL	;Check if valid command.
00300		BEQ	JCMD
00400		DEX
00500		BPL	DL
00600	;Illegal command.
00700	ILLCMD:	LDXI	4	;Command error code.
00800	OCLR:	JSR	OCHR	;Output status.
00900		JMP	IDLSET	;Reset flags.
01000	
01100	JCMD:	LDAX	JLTBL	;Get lsbyte of jump address.
01200		STAZ	CMDJMP
01300		LDAX	JHTBL	;Get msbyte.
01400		STAZ	CJMPH
01500	
01600		JMPIN	CMDJMP	;Excute command.
01700	   ;Fix JMPIN in ASMBL.FAI.
01800	
01900	   NCMDS ← =9	;# of commands -1.
02000	;Swap order for faster DECODE?
02100	CMDTBL:	"W"	;Write data
02200		"R"	;Read data
02300		"E"	;Enter write file.
02400		"C"	;Close write file.
02500		"O"	;Open read file.
02600		"K"	;Delete file.
02700		"D"	;Open directory.
02800		"N"	;Next directory block.
02900		"B"	;Free blocks
03000		"P"	;Perform special function.
03100	
03200	;Check all funny addresses.
03300	JLTBL:	WRITE∧377	;Lsbyte of command address.
03400		READ∧377
03500		ENTR∧377
03600		CLOZE∧377
03700		OPIN∧377
03800		KIL∧377
03900		DIR∧377
04000		NXTDIR∧377
04100		BLKS∧377
04200		PSF∧377
04300	
04400	JHTBL:	WRITE⊗-10	;Msbyte of command address.
04500		READ⊗-10
04600		ENTR⊗-10
04700		CLOZE⊗-10
04800		OPIN⊗-10
04900		KIL⊗-10
05000		DIR⊗-10
05100		NXTDIR⊗-10
05200		BLKS⊗-10
05300		PSF⊗-10
     

00100	;Write command to FDSKC. No wait or * NTRYS.
00200	PCMD:	STAZ	FCMD	;Prom command with no retrys.
00300		LDAI	370	;Msbyte of command table addr.
00400		STAZ	FCMDH
00500		LDAI	0
00600		STAZ	NTRYS
00700		BEQ	WCMD	;Jump.
00800	
00900	RCMD:	LDAI	0	;Ram command with no retrys.
01000		STAZ	NTRYS
01100	TRY:	LDAI	0
01200		STAZ	FCMD
01300		STAZ	FCMDH
01400	
01500	WCMD:	LDAI	377	;Set busy.
01600		STAZ	BUSY	;?
01700		LDAI	0
01800		STAZ	DPOINT	;Reset disk DMA pointer.
01900	
02000	BSYW:	LDA	FDSKC	;Wait until not busy.
02100		BMI	BSYW
02200	
02300		LDYI	0
02400		LDAIY	FCMD	;Get command code.
02500		STA	FDSKC	;Write in disk control reg.
02600	
02700		INCZ	FCMD	;Point to parameter count.
02800		LDAIY	FCMD	;Get count.
02900		BEQ	NOPAR	;If no parameters
03000		TAY
03100	
03200	PARW:	LDA	FDSKC	;Read status
03300		ANDI	40	;P reg full bit.
03400		BNE	PARW	;Wait if still full.
03500	
03600		LDAIY	FCMD	;Parameter
03700		STA	FDSKP
03800		DEY
03900		BNE	PARW	;More left?
04000	
04100	NOPAR:	RTS
04200	
04300	;Disk command with retrys on read error.
04400	RCMDR:	LDAI	RETRY
04500		STAZ	NTRYS
04600		JSR	TRY	;RAM disk command.
04700		RTS
04800	
04900	RCMDW:	JSR	RCMDR	;Read command wait.
05000	BW:	BITZ	BUSY
05100		BMI	BW	;Wait until done
05200		LDAZ	ERFLG	;Get error bits.
05300		RTS	;Return with error bits.
     

00100	;IRQ maskable interrupt routines.
00200	IRQV:	PHA	;Save Registers.
00300		TYA
00400		PHA
00500	
00600		LDA	FDSKP	;Read disk result register.
00700		ANDI	36	;Flush ddbit
00800		STAZ	ERFLG
00900		BNE	DSKERR	;Disk error.
01000		BITZ	DIRC	;Check if write.
01100		BPL	NOTBSY	;No errors.
01200		LDAI	0
01300		STAZ	DIRC	;Not write.
01400		LDAZ	CBLK
01500		CMPI	143	;Check if format command.
01600		BEQ	NOTBSY
01700	
01800		LDAI	137	;Disk verify command.
01900		STAZ	CBLK
02000		JSR	TRY	;Verify write.
02100		JMP	RTRN	;Wait until done.
02200	
02300	DSKERR:	ANDI	20	;Bad bit
02400		BEQ	CKTRY
02500	;Dsk error: RDY,WRT fault, etc.
02600		STAZ	SVERR	;Save bad error.
02700		LDAI	RDSTAT	;Read dirve status.
02800		JSR	PCMD	;No interrupt.
02900	IB:	LDA	FDSKC	;Wait for result.
03000		BMI	IB
03100		LDA	FDSKP	;Read result register.
03200	;Put error routine someplace else?
03300	;20 Not ready.
03400	;21 Write protect.
03500	;22 Restore error.
03600	;23 File not found.
03700	;30 Sector not found.
03800	;Read drive status if not ready for clear.
03900		JMP	NOTBSY
04000	
04100	CKTRY:	LDAZ	NTRYS
04200		BEQ	SETERR
04300		
04400		DECZ	NTRYS
04500		JSR	WCMD	;Retry command.
04600		JMP	RTRN	;Wait until done.
04700	
04800	SETERR:	LDAI	377	;Retry error.
04900		STAZ	SVERR
05000	
05100	NOTBSY:	LDAI	0
05200		STAZ	BUSY	;Set done
05300		STAZ	DIRC	;Reset to read.
05400	
05500	RTRN:	PLA	;Restore Registers.
05600		TAY
05700		PLA
05800		RTI	;Return
     

00100	;Non-maskable DRQ interrupt.
00200	NMIV:	PHA	;Save registers
00300		TYA
00400		PHA
00500		LDYI	0	;No index.
00600	
00700		BITZ	DIRC	;Get direction.
00800		BMI	WDRQ	;Disk write.
00900	
01000		LDA	FDRQ	;Read byte from disk.
01100	
01200		STAIY	DPOINT	;Save it in FBUF
01300		JMP	INCPO	;Increment disk buffer pointer.
01400	
01500	WDRQ:	LDAIY	DPOINT	;Get byte from FBUF.
01600		STA	FDRQ	;Write in disk data register.
01700	
01800	INCPO:	INCZ	DPOINT
01900	
02000		PLA	;Restore registers.
02100		TAY
02200		PLA
02300		RTI	;Return
     

00100	;Directory look up.
00200	;Returns with file found, fnf, or read error.(0,200,XX)
00300	LOKUP:	LDXI	0
00400	GNAME:	JSR	GCHR	;Get name.
00500		CMPI	4	;<EOT>.
00600		BEQ	CKNAME
00700		STAZX	FNAME
00800		INX
00900		CPXI	=10	;9 Chr file name + EOT.
01000		BCC	GNAME
01100	
01200	ILCJMP:	PLA	;One level pop to ILLCMD.
01300		PLA
01400		JMP	ILLCMD
01500	
01600	CKNAME:	TXA	;Test X.
01700		BEQ	ILCJMP	;No file name.
01800		LDAI	" "	;<Space>.
01900	PAD:	STAZX	FNAME	;Pad file name with spaces.
02000		INX
02100		CPXI	=9
02200		BCC	PAD
02300	
02400		JSR	RHDR	;Read directory header sector.
02500		BNE	LUERR
02600		LDAI	FMARK
02700		STAZ	FBLK
02800	
02900	GETS:	JSR	RNDS	;Read next 2 directory sectors.
03000		BNE	LUERR
03100		LDYI	0
03200	CKDIR:	LDXI	0
03300	CKNAM:	LDAY	FBUF
03400		CMPZX	FBLK	;Look for file name.
03500		BNE	NXTF	;No match
03600		INY
03700		INX
03800		CPXI	=11	;9 chrs. + fmark + 1.
03900		BCC	CKNAM
04000	;Names match
04100	FMOV:	LDAY	FBUF	;Save file record.
04200	FMOVE:	STAZX	FBLK
04300		INY
04400		INX
04500		CPXI	20
04600		BCC	FMOV
04700	
04800		LDAI	0	;Return with file found.
04900	LUERR:	RTS	;Return with error bits.
05000	
05100	NXTF:	TYA	;Point to next file record.
05200		ORAI	17
05300		TAY
05400		INY
05500		BNE	CKDIR
05600	
05700		DECZ	SREM	;Check if more sectors.
05800		DECZ	SREM
05900		BNE	GETS
06000		LDAI	200	;Return file not found code.
06100		RTS
     

00100	;Read 1st sec of a directory. Returns with 0 or Ebits.
00200	RHDR:	JSR	MOTON	;Turn on motor and delay.
00300		LDXI	4
00400	CSET:	LDA⊗	RH0	;Setup command list.
00500		STAZX	CBLK
00600		DEX
00700		BPL	CSET
00800	
00900		JSR	SETDPO	;Point disk to FBUF.
01000		JSR	RSEC	;Read it * 16.
01100		BNE	HERR
01200		LDA	FBUF
01300		CMPI	DMARK	;Check for directory.
01400		BNE	HERR
01500	
01600	GHDR:	LDXI	7
01700	GHL:	LDAX	FBUF
01800		STAZX	DBLK
01900		DEX
02000		BPL	GHL
02100		LDAZ	DSEC
02200		STAZ	SREM	;Number of sectors in dir.
02300		STAZ	DIRCNT	;Reset directory count.
02400		LDAI	0	;No error return
02500	HERR:	RTS	;Return with error bits.
02600	
02700	;Read next dir. sector. Returns with error bits.
02800	RNDS:	INCZ	CSEC	;Read next dir sec.
02900		INCZ	CSEC
03000	RSEC:	JSR	RCMDW	;Disk command wait * RETRYS
03100		BEQ	GOTIT	;Good read
03200		LDAI	LASTRK	;Last track
03300		STAZ	CTRK
03400		JSR	RCMDW
03500		LDAI	0	;Fix CTRK for next read.
03600		STAZ	CTRK
03700		LDAZ	ERFLG	;Get error bits.
03800	GOTIT:	RTS	;Return with error bits.
03900	
04000	SETDPO:	LDAI	0	;Point disk to FBUF
04100		STAZ	DPOINT
04200		LDAI	FBUF⊗-10
04300		STAZ	DPOH
04400		RTS
     

00100	;Open read file.
00200	OPIN:	BITZ	WFOPEN	;Check if write file open.
00300		BPL	LOOK
00400		JMP	FAO	;File already open error.
00500	
00600	LOOK:	JSR	LOKUP	;Lookup file FNAM
00700		BEQ	SETOPN
00800		CMPI	200	;File not found code.
00900		BEQ	NACKIT
01000		JMP	DIRERR	;Directory read error
01100	NACKIT:	JMP	FNF	;File not found.
01200	
01300	SETOPN:	LDAZ	FTRK	;Get track and sector
01400		STAZ	CTRK
01500		LDAZ	FSEC
01600		STAZ	CSEC
01700		LDAZ	NSEC	;Get file length.
01800		STAZ	SREM
01900	;Fill FBUF
02000		JSR	RCMDR	;* NTRYS and no wait.
02100	
02200		JSR	SETSPO	;Point SPOINT to FBUF.
02300		LDAI	377
02400		STAZ	RFOPEN
02500	
02600	ACK:	LDXI	20	;<ack>
02700	OACK:	JSR	OCHR	;Output byte.
02800		JSR	SPIN
02900		JMP	IDLE	;No flag clear.
03000	
03100	SETSPO:	LDAI	0	;Reset SI/O pointer.
03200		STAZ	SPOINT
03300		LDAI	FBUF⊗-10
03400		STAZ	SPOH
03500		RTS
     

00100	;Read a block of the file.
00200	READ:	JSR	GEOT	;Wait for EOT.
00300		BITZ	RFOPEN	;Check if file open.
00400		BMI	CKS
00500		JMP	FNF	;File not found
00600	CKS:	LDAZ	SREM	;Check for end of file.
00700		BNE	READO	;For FLEN = 0.
00800	EOF:	LDXI	6	;End of file error code.
00900		JMP	OCLR	;Output X and clear flags.
01000	
01100	READO:	LDAI	0	;Init check sum.
01200		STAZ	CKSUM
01300	RW:	BITZ	BUSY	;Wait until not busy.
01400		BMI	RW
01500		LDAZ	ERFLG	;Check for *16 read error.
01600		BEQ	NXTBUF
01700	DRERR:	LDXI	14	;Disk read error.
01800		JMP	OCLR
01900	
02000	NXTBUF:	DECZ	SREM	;Check if end of file.
02100		DECZ	SREM
02200		BEQ	ACKIT
02300	   ;Start read of next buffer.
02400		INCZ	CSEC	;Next sector.
02500		INCZ	CSEC
02600		LDAZ	CSEC	;Check if next track.
02700		CMPI	=16
02800		BCC	RNS
02900		LDAI	1	;First sector.
03000		STAZ	CSEC
03100		INCZ	CTRK	;Next track.
03200	
03300	RNS:	JSR	SWDBUF	;Swap disk buffers.
03400		JSR	MOTON	;Turn on motor.
03500		JSR	RCMDR	;No wait.
03600	ACKIT:	JSR	PACK	;Output <ack>.
03700		JSR	PSTX	;Output <stx>.
03800	
03900		LDYI	0
04000	RDIT:	LDAIY	SPOINT	;Output a buffer full.
04100		TAX
04200		JSR	OCHR
04300		TXA
04400		CLC
04500		ADCZ	CKSUM
04600		STAZ	CKSUM
04700		INY
04800		BNE	RDIT
04900	
05000		JSR	SWSBUF	;Swap SI/O buffers.
05100		LDAZ	CKSUM	;Output check sum.
05200		EORI	377
05300		TAX
05400		INX
05500		JMP	OACK	;Output it and no flag clear.
05600	
05700	SWSBUF:	LDAZ	SPOH
05800		EORI	1	;Swap SI/O buffers.
05900		STAZ	SPOH
06000		RTS
     

00100	;Create file routine
00200	ENTR:	BITZ	WFOPEN	;Check if file already open
00300		BPL	CLRFO
00400	FAO:	LDXI	10	;File already open error.
00500		JMP	OACK	;Output it.
00600	CLRFO:	LDAI	0	;Put clear read file in RHDR?
00700		STAZ	RFOPEN	;Close read file.
00800	LOKIT:	JSR	LOKUP	;Check if file already exists.
00900		BEQ	FEXIST	;Check if file exists
01000		CMPI	200	;Not in dir. code
01100		BEQ	FULCK
01200	DIRERR:	LDXI	13	;Directory read error code.
01300		JMP	OCLR	;Clear flags.
01400	
01500	FEXIST:	LDXI	2	;File exists error code.
01600		JMP	OCLR	;Clear flags.
01700	
01800	DSKFUL:	LDAI	LASTRK	;Disk full. Check close?
01900		STAZ	FFTRK	;Set full flag.
02000		LDXI	5	;Disk full code.
02100		JMP	OCLR	;Output and clear flags?
02200	
02300	FULCK:	LDAZ	FFTRK	;Get first free track.
02400		CMPI	LASTRK	;Check if disk full.
02500		BCS	DSKFUL
02600	
02700		STAZ	CTRK	;Point to new file.
02800		STAZ	FTRK	;Setup file block.
02900		STAZ	CLEN	;Track number for seek.
03000		LDAI	151	;Seek track command.
03100		STAZ	CBLK
03200		LDAI	1
03300		STAZ	CCNT
03400	
03500		JSR	RCMD	;Seek track.
03600	
03700		LDAI	3	;Setup command parameter count.
03800		STAZ	CCNT
03900		STAZ	DPOH	;Point disk to other buffer.
04000		LDAI	2	;Setup number of sectors.
04100		STAZ	CLEN
04200		LDXZ	FFSEC
04300		STXZ	FSEC	;Setup file block.
04400		DEX	;-1 For inc. before write.
04500		DEX
04600		STXZ	CSEC
04700	
04800		JSR	SETSPO	;Point SI/O to FBUF.
04900		LDAI	0
05000		STAZ	FLEN	;Reset file length.
05100	
05200		LDAI	377	;Set write file open flag.
05300		STAZ	WFOPEN
05400		JMP	ACK	;Return with no errors
     

00100	;Write file.
00200	;Fix full check for write last sector?
00300	WRITE:	JSR	GEOT	;Wait for EOT.
00400		BITZ	WFOPEN	;Check if file open.
00500		BMI	WIT
00600		JMP	FNF	;File not found
00700	WIT:	LDAZ	FFTRK
00800		CMPI	LASTRK	;Check if disk is full.
00900		BCS	DSKFUL
01000	
01100		LDAI	0
01200		STAZ	CKSUM	;Init check sum.
01300	
01400		JSR	PACK	;Output <ACK>.
01500		JSR	GCHR	;Wait for STX.
01600		CMPI	2	;<STX>.
01700		BNE	COMERR	;No STX.
01800	   ;Check for COMERR?
01900	
02000		LDYI	0
02100	WLOOP:	JSR	GCHR	;Fill FBUF.
02200		STAIY	SPOINT
02300		CLC
02400		ADCZ	CKSUM	;Update check sum.
02500		STAZ	CKSUM
02600		INY
02700		BNE	WLOOP
02800	
02900		JSR	GCHR	;Get check sum.
03000		CLC
03100		ADCZ	CKSUM	;Check for check sum error.
03200		BNE	COMERR
03300		LDAZ	CEFLG	;Check for communication error.
03400		BEQ	WBUF
03500	COMERR:	LDXI	11	;Communication error.
03600		JMP	OCLR	;Reset flags.
03700	
03800	WBUF:	BITZ	BUSY	;Wait until last buffer done.
03900		BMI	WBUF
04000		LDAZ	ERFLG	;Check for errors.
04100		BEQ	NFBLK
04200		JMP	DRERR	;Write error. Verify error?
04300	NFBLK:	LDXZ	CSEC	;Fix sector number.
04400		INX
04500		INX
04600		CPXI	=16	;Check if end of track.
04700		BCC	SWBUF
04800		LDXI	1	;First sector.
04900		INCZ	CTRK	;Next track.
05000		LDAZ	CTRK
05100		CMPI	LASTRK	;Check if disk full?
05200		BCC	SWBUF
05300		JMP	DSKFUL
     

00100	SWBUF:	STXZ	CSEC	;Next sector.
00200		JSR	SWDBUF	;Swap disk buffers.
00300		JSR	MOTON	;Turn on motor.
00400		JSR	WBUFR	;Write buffer.
00500		
00600		JSR	SWSBUF	;Swap SI/O buffers.
00700		INCZ	FLEN	;Update file length.
00800		INCZ	FLEN
00900		JMP	ACK	;No error return.
01000	
01100	WBUFR:	LDAI	113	;Write two sectors command.
01200		STAZ	CBLK
01300	WUF:	LDAI	377
01400		STAZ	DIRC	;Set to write.
01500		JSR	RCMDR	;* NTRYS.
01600		RTS
01700	
01800	WBUFW:	JSR	WBUFR	;Write it.
01900		JMP	BW	;Return with E bits when done.
02000	
02100	SWDBUF:	LDAZ	DPOH
02200		EORI	1	;Swap disk buffers.
02300		STAZ	DPOH
02400		RTS
     

00100	CLOZE:	JSR	GEOT	;Wait for EOT.
00200		BITZ	WFOPEN	;Check if file open
00300		BMI	UPDIR
00400		JMP	FNF	;File not found.
00500	
00600	;Update directory
00700	UPDIR:	BITZ	BUSY	;Wait until not busy.
00800		BMI	UPDIR
00900		LDAZ	ERFLG	;Check for error.
01000		BEQ	BUMP
01100		JMP	DRERR	;Last buffer write error?
01200	
01300	BUMP:	LDAZ	FLEN	;Save file length.
01400		STAZ	NSEC
01500		LDAZ	CTRK	;Save new FFTRK.
01600		STAZ	HTRK
01700		LDXZ	CSEC	;Point to next free data block.
01800		INX
01900		INX
02000		CPXI	=16	;Number of secs. per track +1.
02100		BCC	FIXFF
02200		INCZ	HTRK	;Next track.
02300		LDXI	1	;First sector.
02400	FIXFF:	STXZ	HSEC	;Save new FFSEC.
02500	
02600	;Read last directory sector.
02700		LDAI	123	;Read two sectors command.
02800		STAZ	CBLK
03100		LDAI	0	;Track zero.
03200		STAZ	CTRK
03300	
03400		LDXZ	DSEC	;Last directory sector -1.
03500		INX	;Bump.
03600		STXZ	CSEC
03700		STXZ	SREM	;Save last dir. sec. number.
03800		JSR	SETDPO	;Point to FBUF.
03900		JSR	RSEC	;Read next dir. sec.
04000		BEQ	CLOZIT
04100	RDE:	JMP	DIRERR	;Directory read error.
04200	
04300	CLOZIT:	LDYZ	FFDIR
04400	
04500		LDXI	0	;BLT FBLK into directory
04600	NAMEIT:	LDAZX	FBLK
04700		STAY	FBUF
04800		INY
04900		INX
05000		CPXI	20	;FBLK Length
05100		BCC	NAMEIT
05200	
     

00100	;Update directory header.
00200	WRTH0:	CLC
00300		LDAZ	FFDIR
00400		ADCI	20	;Update end of dir.
00500		STAZ	FFDIR
00600		BNE	UPFF
00700		INCZ	DSEC	;Next sector
00800		INCZ	DSEC
00900		LDAZ	DSEC	;Check if directory full.
01000		CMPI	=15
01100		BCC	UPFF
01200		LDAI	=14	;Last directory sector.
01300		STAZ	DSEC
01400		LDAI	LASTRK	;Set disk full.
01500		STAZ	HTRK
01600	UPFF:	LDAZ	HSEC	;Point to next free block.
01700		STAZ	FFSEC
01800		LDAZ	HTRK
01900		STAZ	FFTRK
02000		SEC
02100		LDAZ	FBLKS
02200		SBCZ	FLEN	;Update free blocks.
02300		STAZ	FBLKS
02400		BCS	WDIR
02500		DECZ	FBH
02600	
02700	WDIR:	LDXI	7	;Header length
02800	HLOOP:	LDAZX	DBLK	;BLT Header into directory
02900		STAX	FBUF1	;Other buffer.
03000		DEX
03100		BPL	HLOOP
03200	
03300		JSR	WBUFW	;Write dir. 0.
03400	
03500		LDAI	1	;First sector.
03600		STAZ	CSEC
03700		JSR	SWDBUF	;Swap disk buffers.
03800	
03900		JSR	WBUFW	;Write dir. header 0.
04000		LDAI	LASTRK	;Last track
04100		STAZ	CTRK
04200		JSR	WBUFW	;Write dir. header 1.
04300	   ;Write last track directory.
04400		LDAZ	SREM	;Get last dir.sec. number.
04500		STAZ	CSEC
04600		JSR	SWDBUF	;Swap buffers.
04700		JSR	WBUFW
04800		BNE	CLZERR
04900	
05000		LDAZ	SVERR	;?
05100		BEQ	CLOZD
05200	   ;Close error.
05300	CLZERR:	JMP	DIRERR	;?
05400	CLOZD:	STAZ	WFOPEN	;Reset write file open flag.
05500		JMP	ACK
     

00100	PSF:	JSR	GEOT
00200		JSR	PACK	;<Ack>
00300		JSR	GCHR	;Wait for SOH.
00400		CMPI	1	;SOH
00500		BNE	PSFERR
00600		JSR	GCHR	;Wait for special function cmd.
00700		CMPI	"Q"	;Compress holes.
00800		BNE	CKF
00900		JSR	GEOT	;Wait for EOT.
01000		JMP	CMPRES
01100	
01200	CKF:	CMPI	"F"	;Format disk.
01300		BNE	CKI
01400		JMP	FORM
01500	CKI:	CMPI	"I"	;Initialize directory.
01600		BEQ	IDIR
01700	PSFERR:	JMP	ILLCMD	;Command error.
01800	;Initialize directory.
01900	IDIR:	JSR	GEOT	;Wait for EOT.
02000		JSR	MOTON	;Turn on motor.
02100		LDXI	10
02200		LDAI	0
02300	ZE:	STAX	FBUF	;Zero directory
02400		INX
02500		BNE	ZE
02600		LDXI	7
02700	DIIL:	LDAX	DIT	;Init dir.
02800		STAX	FBUF
02900		DEX
03000		BPL	DIIL
03100	
03200		LDXI	4
03300	SETC:	LDAX	ID0	;Setup CBLK.
03400		STAZX	CBLK
03500		DEX
03600		BPL	SETC
03700	
03800		JSR	SETDPO	;Point disk to FBUF.
03900		JSR	WBUFW	;Write first header and dir.
04000		LDAI	LASTRK	;Last track.
04100		STAZ	CTRK
04200		JSR	WBUFW	;Init last directory.
04300	
04400		BEQ	OK	;Check for errors.
04500		LDAZ	SVERR
04600		BNE	IDERR
04700	OK:	JMP	ACK
04800	IDERR:	LDXI	7	;Init dir. error.
04900		JMP	OCLR	;Reset flags.
05000	
05100	DIT:	DMARK
05200		2	;# of sectors
05300		0	;FFDB
05400		1	;FFT
05500		1	;FFS
05600		=528∧377	;FBL?
05700		1	;FBH
05800		0
     

00100	;Delete file.
00200	KIL:	JSR	LOKUP
00300		BEQ	KILIT
00400	FNF:	LDXI	3	;File not found.
00500		JMP	OCLR
00600	KILIT:	LDAI	HMARK
00700		STAY	760	;FBUF - 20
00800		LDXZ	CSEC
00900		STXZ	SREM	;Save directory sector.
01000		CPYZ	FFDIR	;Check if last dir. block.
01100		BNE	DEL
01200		DEX
01300		TYA	;Test Y.
01400		BNE	DEL
01500		INX
01600		INX
01700	CKSEC:	CPXZ	DSEC	;Check if last block in dir.
01800		BNE	DEL
01900		SEC
02000		SBCI	20	;Point to FFDIR -1 block.
02100		STAZ	FFDIR
02200		TYA	;Test Y.
02300		BNE	DEL
02400		DECZ	DSEC	;Directory sector -2.
02500		DECZ	DSEC
02600	
02700	DEL:	JMP	WDIR	;Write header and directory.
     

00100	DIR:	JSR	GEOT	;Wait for EOT.
00200		JSR	RHDR	;Read header.
00300		BEQ	RQDIR
00400	JDER:	JMP	DIRERR	;Error.
00500	RQDIR:	LDAI	0	;Point to start
00600		STAZ	DIRCNT
00700	JACK:	JMP	ACK
00800	
00900	NXTDIR:	JSR	GEOT	;Wait for EOT.
01000		LDXZ	DIRCNT	;Check if at end.
01100		CPXZ	DSEC	;Check if done.
01200		BCC	NXD
01300		JMP	EOF
01400	
01500	NXD:	INX
01600		INX
01700		STXZ	DIRCNT	;Update directory count.
01800		INX	;Bump past dir. header.
01900		STXZ	CSEC
02000	
02100		JSR	RSEC	;Read next directory sector.
02200		BNE	JDER
02300	
02400		JSR	PACK	;Output <ACK>.
02500		JSR	PSTX	;Output <STX>.
02600		LDYI	0
02700	DOL:	LDAY	FBUF	;Find file in FBUF.
02800		LDXI	11	;9 Chr file name + # of secs.
02900		STXZ	HSEC
03000	
03100	OUTDIR:	CMPI	FMARK
03200		BNE	OUTZ
03300	
03400		LDXY	1001	;FBUF + 1.
03500	FBOUT:	PHA
03550	        JSR	OCHR	;Output it.
03575	        PLA
03600		INY
03700		DECZ	HSEC
03800		BPL	OUTDIR
03900	
04000	NXBLK:	TYA
04100		ORAI	17	;Next file block.
04200		TAY
04300		INY
04400		BNE	DOL
04500		BEQ	OEOT	;Jump.
04600	
04700	OUTZ:	LDXI	0	;Null file block. (Hole)
04800		BEQ	FBOUT	;Jump.
04900	
05000	;Output free blocks.
05100	BLKS:	JSR	GEOT	;Wait for EOT.
05200		JSR	RHDR	;Read directory header.
05300		BNE	DJ	;Directory read error.
05400		JSR	PACK	;<ack>
05500		JSR	PSTX	;Output STX.
05600		LDXZ	FBLKS
05700		JSR	OCHR
05800		LDXZ	FBH
05900		JSR	OCHR
06000	OEOT:	LDXI	4	;<EOT>.
06100		JMP	OCLR	;Clear flags.
     

00100	;Compress holes.
00200	CMPRES:	JSR	RHDR	;Read directory header.
00300		BNE	DJ
00400		JSR	SWDBUF	;Point disk to other buffer.
00500	SQEZ:	JSR	RNDS	;Read directory.
00600		BNE	DJ
00700		LDYI	0
00800	CKHOL:	LDAY	FBUF1	;Other buffer.
00900		CMPI	FMARK	;Look for a hole.
01000		BNE	HOLE
01100		TYA
01200		CLC
01300		ADCI	20	;Next directory record.
01400		TAY
01500		BNE	CKHOL
01600	
01700		DECZ	SREM	;SREM ← SREM - 2.
01800		DECZ	SREM
01900		BNE	SQEZ
02000	PACKED:	JMP	ACK	;Done.
02100	DJ:	JMP	DIRERR	;Directory read error.
02200	
02300	;Hole found.
02400	HOLE:	LDAY	1413	;FBUF1 + TRK#
02500		STAZ	HTRK	;Save hole track.
02600		LDAY	1414	;FBUF1 + SEC#
02700		STAZ	HSEC	;Save hole sector.
02800		STYZ	SVHY	;Save hole dir. index.
02900		LDAZ	CSEC
03000		STAZ	SVHSEC	;Save hole dir. sector.
03100	
03200	FINDF:	TYA	;Find next file.
03300		CLC
03400		ADCI	20	;Next dir. record.
03500		TAY
03600		BNE	CKFIL
03700		DECZ	SREM	;SREM ← SREM - 2.
03800		DECZ	SREM
03900		BEQ	PACKED	;Done.
04000		JSR	RNDS	;Read next directory sector.
04100		BNE	DJ	;Error.
04200		TAY	;Y ← 0.
04300	CKFIL:	LDAY	FBUF
04400		CMPI	FMARK
04500		BNE	FINDF
04600	   ;File found. Save file address.
04700		LDXI	0
04800		JSR	FMOVE	;Save FBLK.
04900		STYZ	FFDIR	;Save directory index +20.
05000		LDXI	2
05100	FILAD:	LDAZX	NSEC	;Save file addr. and length.
05200		STAZX	FLEN	;FLEN, FITRK, and FISEC.
05300		DEX
05400		BPL	FILAD
     

00100	;Fill hole.
00200	FILLIT:	LDAZ	FITRK	;Point to file.
00300		STAZ	CTRK
00400		LDAZ	FISEC
00500		STAZ	CSEC
00600		LDAI	123	;Read two sectors command.
00700		STAZ	CBLK
00800		JSR	RCMDW	;Read it.
00900		BNE	DJ
01000	
01100		LDAZ	HTRK	;Point to hole.
01200		STAZ	CTRK
01300		LDAZ	HSEC
01400		STAZ	CSEC
01500		CLC
01600		ADCI	2	;Next hole sectors.
01700		CMPI	=16
01800		BCC	WRIT
01900		INCZ	HTRK	;Next track.
02000		LDAI	1	;First sector.
02100	WRIT:	STAZ	HSEC
02200		JSR	WBUFW	;Fill hole.
02300		BNE	DJMP
02400	
02500		DECZ	FLEN	;FLEN ← FLEN - 2.
02600		DECZ	FLEN
02700		BEQ	CUPD	;Check if hole filled.
02800		LDAZ	FISEC
02900		CLC
03000		ADCI	2	;Next file sectors.
03100		CMPI	=16
03200		BCC	UPSEC
03300		INCZ	FITRK	;Next track.
03400		LDAI	1	;First sector.
03500	UPSEC:	STAZ	FISEC
03600		BNE	FILLIT	;Jump.
03700	
03800	CUPD:	LDXZ	CSEC	;Get next hole.
03900		INX
04000		INX
04100		CPXI	=16
04200		BCC	SVTRK
04300		INCZ	CTRK	;Next track.
04400		LDXI	1	;First sector.
04500	SVTRK:	STXZ	HSEC
04600		LDAZ	CTRK
04700		STAZ	HTRK
04800	
04900		LDAZ	SVHSEC	;Update directory.
05000		STAZ	CSEC	;Get hole dir. sector.
05100		LDAI	0	;Track zero.
05200		STAZ	CTRK
05300		JSR	RSEC	;Read hole dir. sector.
05400		BEQ	FIXDIR
05500	DJMP:	JMP	DIRERR	;Directory read error.
     

00100	FIXDIR:	LDXI	0
00200		LDYZ	SVHY	;Get hole dir. index.
00300	UPBLK:	LDAZX	FBLK	;FBUF ← FBLK - TRK&SEC
00400		STAY	FBUF
00500		INY
00600		INX
00700		CPXI	13	;FNAME + FMARK & NSEC.
00800		BCC	UPBLK
00900		JSR	WBUFW	;Write new dir.
01000		BNE	DJMP
01100	;Find next file.
01200		LDYZ	FFDIR	;Get first free dir. block.
01300	   ;FBUF ← DIR(Y)
01400	   ;Update old file directory.
01500	   ;Fix SVHY & SVHSEC.
01600		JMP	FINDF	;Find next file.
     

00100	GEOT:	JSR	GCHR	;Wait for EOT.
00200		CMPI	4	;<EOT>
00300		BNE	TERR
00400		LDAZ	CEFLG	;Checkk for comm. error.
00500		BNE	TERR
00600		RTS
00700	TERR:	PLA	;Fix stack?
00800		PLA
00900		JMP	ILLCMD	;?
01000	
01100	FORM:	JSR	GEOT
01200		JSR	MOTON	;Turn on motor.
01300	
01400		JSR	SETDPO	;Point to FBUF.
01500		LDXI	6
01600	CSLOP:	LDAX	FORMT	;Setup command list.
01700		STAZX	CBLK
01800		DEX
01900		BPL	CSLOP
02000	
02100	TKOOP:	LDXI	1	;First sector.
02200		LDYI	0
02300	SCOOP:	LDAZ	FOTRK	;Get track number.
02400		STAY	FBUF	;And setup I.D.s.
02500		INY
02600		LDAI	0
02700		STAY	FBUF	;Head number.
02800		INY
02900		TXA
03000		STAY	FBUF	;Sector number.
03100		INY
03200		LDAI	0
03300		STAY	FBUF	;Length.
03400		INY
03500		INX	;Next sector.
03600		CPXI	=17	;Sectors per track +1.
03700		BCC	SCOOP
03800	
03900		JSR	WUF	;Write buffer.
04000	FW:	BITZ	BUSY	;Wait until not busy.
04100		BMI	FW
04200	   ;Add verify 16 sectors?
04300		INCZ	FOTRK	;Next track.
04400		LDAZ	FOTRK
04500		CMPI	=35
04600		BCC	TKOOP
04700	
04800		LDAZ	SVERR	;Check for errors.
04900		BNE	FERR
05000		JMP	ACK
05100	FERR:	JMP	DIRERR
     

00100	;Wait for input.
00200	GCHR:	LDA	SIOC	;Read SI/O status.
00300		LSRA	;Get rcvr. full bit.
00400		BCC	GCHR
00500		ANDI	30	;FE, OVR.
00600		BEQ	GOT1
00700		STAZ	CEFLG
00800	GOT1:	LDA	SIOD
00900		RTS
01000	
01100	PACK:	LDXI	6	;Output <ack>.
01200	;Output byte in X.
01300	OCHR:	LDA	SIOC	;Read SI/O status.
01400		ANDI	2	;Transmiter full bit.
01500		BEQ	OCHR
01600		STX	SIOD	;Output it.
01700		RTS
01800	PSTX:	LDXI	2	;Output <stx>.
01900		BNE	OCHR
02000	
02100	MOTOFF:	LDAI	MOFF	;Turn motor off.
02200		JSR	PCMD
02300		LDAI	0
02400		STAZ	MO	;Motor on flag.
02500		RTS
02600	
02700	   ONES ← 6	;6 = .98s, 7 = 1.15s.
02800	MOTON:	BITZ	MO	;Check if already on.
02900		BMI	SPIN
03000		LDAI	377	;Turn on motor.
03100		STAZ	TL	;Setup motor time out.
03200		LDAI	ONES
03300		STAZ	TH
03400		LDAI	MON	;Turn it on.
03500		JSR	PCMD
03600	
03700		LDXI	0	;Wait for motor on delay.
03800	MW:	DEX
03900		BNE	MW
04000		DECZ	TL
04100		BNE	MW
04200		DECZ	TH
04300		BNE	MW
04400	
04500		LDAI	377
04600		STAZ	MO	;Set motor on flag.
04700	SPIN:	LDAI	377	;Setup motor time out.
04800		STAZ	TL
04900		LDAI	TWOS
05000		STAZ	TH
05100		RTS
05200	
05300	;Reset and interrupt vectors.
05400	   LOC ZERO + 177772
05500		NMIV∧377	;NMI Vector.
05600		NMIV⊗-10
05700		RST∧377	;Reset vector.
05800		RST⊗-10
05900		IRQV∧377	;IRQ Vector.
06000		IRQV⊗-10
06100	END